home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb9.arc / TIMESTMP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-08-21  |  2.4 KB  |  111 lines
  1. program timestmp ;
  2.  
  3. {  The function reads the internal clock and returns a string
  4.    of the form "July 5, 1984 9:30am" which is useful for
  5.    headings on listings and reports.  }
  6.  
  7. type
  8.   stdstr = string [80] ;
  9.  
  10.   RecPack = record
  11.     AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAG : integer ;
  12.   end ;
  13.  
  14. var
  15.   regs : RecPack ;
  16.   ch   : char    ;
  17.  
  18. function StrInt(n : integer) : stdstr ;
  19.   {  return a string with the integer in ASCII  }
  20. var
  21.   s : string [6] ;
  22.   begin
  23.     str(n,s) ;
  24.     StrInt := s ;
  25.   end ;
  26.  
  27. procedure CallDos(fcn : integer) ;   { execute DOS fcn # call }
  28. begin
  29.   with regs do
  30.   begin
  31.     AX := fcn ;
  32.     MsDos(regs) ;
  33.   end ;  { with }
  34. end ;
  35.  
  36. function kbin : char ;
  37. {  returns key value entered at kbd immediately;
  38.    no display, handle extended codes. }
  39. var
  40.   c : char ;
  41.   n : integer ;
  42.  
  43. begin
  44.   CallDos($800) ;     { DOS pg D-8 }
  45.   n := Lo(regs.AX) ;
  46.     if n = 25 then
  47.       begin           { ^Y to halt }
  48.         writeln ('^Y program halting.  What is condition of open files?') ;
  49.         delay (200) ;
  50.         halt ;
  51.       end ;
  52.     if n = 0 then
  53.       begin           { ext code }
  54.         CallDos($800) ;
  55.         n := Lo(regs.AX) ;
  56.         if n > 127 then n := n - 124 ;
  57.         n := n + 128 ;
  58.       end ;           { ext }
  59.     kbin := chr(n) ;
  60. end ;
  61.  
  62. function timestamp : stdstr ;
  63. {  return string of "MON DAY YEAR TIME" }
  64. type
  65.   mot = array [1..12] of string [3] ;
  66. const
  67.   mon : mot = ( 'JAN','FEB','MAR','APR','MAY','JUN',
  68.                 'JUL','AUG','SEP','OCT','NOV','DEC' ) ;
  69. var
  70.   tsret : stdstr  ;
  71.   hr    : integer ;
  72.   ampm  : string [2] ;
  73.  
  74. begin
  75.   CallDos($2A00) ;
  76.   with regs do
  77.     begin
  78.       tsret := mon[Hi(DX)] + ' ' + StrInt(Lo(DX)) + ',' + StrInt(CX) + ' ' ;
  79.       CallDos($2C00) ;
  80.       hr := Hi(CX) ;
  81.       if hr > 12 then
  82.         begin
  83.           hr := hr - 12 ;
  84.           ampm := 'pm' ;
  85.         end
  86.     else
  87.       ampm := 'am' ;
  88.       timestamp := tsret + (StrInt(hr)) + ':' + (StrInt(Lo(CX))) + ampm ;
  89.         end ;  { with }
  90.     end ;
  91.  
  92. begin
  93. writeln ('Demonstration of the TIMESTAMP function: ',timestamp) ; writeln ;
  94. writeln ('The following demonstrates kbin vs keypress (entering q will quit)');
  95.   repeat
  96.     writeln (' using kbin to get extended codes') ;
  97.     ch := kbin ;
  98.     writeln (ch, ord(ch):4) ;
  99.     writeln ( 'Using read(kbd,ch)') ;
  100.     read (kbd,ch) ;
  101.     writeln (ch, ord(ch):4) ;
  102.   until ch = 'q' ;
  103. end.
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.